perm filename KSIG.FAI[XX,LCS]4 blob
sn#233026 filedate 1976-08-23 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE KSIG 00100 SUBROUTINE KSIG
C00025 ENDMK
Cā;
TITLE KSIG ; 00100 SUBROUTINE KSIG
ENTRY KSIG,METER,MAKNUM
EXTERNAL NOZERO,.COMM.,ITMSUB,POSI
EXTERNAL ALPHA,IFIX,STF,AMOD,CENTX,SLUR,NOTWRT,CENTX
KSIG: 0 ; FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
;00300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
;00400 C*******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
;00500 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
;00600 1,(R6,RJQ(4))
MOVEI 02,11 ; JA=9
MOVEM 2,.COMM.+1 ; C USES THIS KEY NUM IN NOTWRT
; COUNTER -- IZ=IABS(J5)
MOVM 15,.COMM.+=26 ; NUMBER OF CALLS ON NOTWRT
; 01300 C THE CLEF NUM. IT GETS WIPED OUT IN NOTWRT.
; 01400 JW=1
MOVEI 2,1
; 01500 R6=0
SETZM .COMM.+7
; 01600 IF(J5.GT.0)JW=2
SKIPLE .COMM.+=26
AOS 2 ; 01700 C THE CODE FOR FLAT OR SHARP
CAIGE 15,144 ; 01800 IF(IZ.LT.100)GO TO 5333
JRST KS1
MOVEI 2,3 ; 01900 JW=3
SUBI 15,144 ; 02000 IZ=IZ-100
; 2100 WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
KS1: MOVEM 2,JW# ; 02200 5333 CLEF=J6+1
MOVE 4,.COMM.+=27
MOVEM 4,CLEF#
;CLEF #S ARE 0,1,2,3 (TREB.,BA.,ALT.,TEN.)
; 02400 C CLEF NOW SET IN MAIN PROG.
; 02500 C IF NO CLEF GIVEN, TREBLE IS USED.
; 02600 T=10.
MOVSI 13,204500 ; 13 IS T
CAILE 4,1 ;2700 IF(CLEF.GT.1.)T=11.
MOVSI 13,204540
MOVEM 13,T#
CAIN 4,3
JRST KSX
MOVNI 2,(4) ; 02800 S=3-CLEF
ADDI 2,3
SKIPA
KSX: SETO 2, ; 02900 IF(CLEF.EQ.3)S=-1.
FLTR 2,2 ;TLC 2,232000
;; FADR 2,2
MOVEM 2,S#
; 03000 IF(J5.LT.0)GO TO 253
MOVE 02,.COMM.+=26
JUMPL 02,KS2
; 03100 W=-3.
MOVN 02,[3.0]
; 03200 YY=4.
MOVSI 3,203400
; 03300 Z=11.
MOVSI 4,204540 ; 03400 C SHARPS
; 03500 GO TO 353
JRST KS3
; 03600 253 W=-4
KS2: MOVN 2,[4.0]
; 03700 YY=3.
MOVSI 3,202600
; 03800 Z=7.
MOVSI 4,203700 ; 03900 C FLATS
KS3: MOVEM 2,W# ; 04000 353 N=-1
MOVEM 3,YY#
SETOM N#
FADR 4,.COMM.+5 ;4100 Z=Z+R4
MOVE .COMM.+4 ;RX=R3
MOVEM RX#
; 04300 RA=0
SETZM RA#
; 04400 C RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
MOVSI 204640
FMPR STF+=8
MOVEM .COMM.+=27 ; SAVES IT IN J6
MOVEM 15,IZ# ; 04500 DO 553 KA=1,IZ
MOVEI 15,1
; 04600 J5=JW
KS6: MOVE 02,JW
MOVEM 02,.COMM.+=26
; 04700 R3=RX+RA
MOVE 02,RX
FADR 02,RA
MOVEM 02,.COMM.+4
; 04800 RA=RA+13.*RSTJ2
MOVE 02,.COMM.+=27
FADRM 02,RA ; 04900 C MOVES OVER FOR NEXT ACCI.
; 05000 RD=Z
MOVEM 4,RD#
; 05100 R4=Z
MOVEM 4,.COMM.+5
SKIPE CLEF ; 05200 IF(CLEF.NE.0)GO TO 7
JRST KS7
CAMG 4,[12.0] ;5300 IF(R4.GT.12.)R4=R4-7.
JRST KS9
MOVN 02,[7.0]
FADRM 02,.COMM.+5
; 05400 GO TO 9
JRST KS9
; 05500 7 R4=R4-S
KS7: MOVN 02,S
FADRB 02,.COMM.+5
CAMG 2,T ; 05600 IF(R4.GT.T)R4=R4-7.
JRST KS9
MOVN 02,[7.0]
FADRM 02,.COMM.+5 ;5700 ABOVE ARRANGES VERT. POS OF ACCIS.
; 05800 9 J4=R4
;;KS9: JSA 16,IFIX
;; JUMP .COMM.+5
KS9: KIFIX 0,.COMM.+5
MOVEM 00,.COMM.+=25
; 05900 C FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
JSA 16,CENTX
JSA 16,NOTWRT
; 06200 Z=RD+W
MOVE 4,W
SKIPG N ; 06300 IF(N.GT.0)Z=RD+YY
MOVE 4,YY ; N WAS -1 1ST TIME.
FADR 4,RD
; 06400 553 N=-N
MOVNS 00,N
CAMGE 15,IZ
AOJA 15,KS6
JRA 16,(16) ; 06500 END
METER: 0 ;24300 SUBROUTINE METER
; 25100 CALL NOZERO(R7)
JSA 16,NOZERO
JUMP .COMM.+=8
; 25200 JZ=J3
MOVE 02,.COMM.+=24
MOVEM 02,JZ#
; 25300 RY=R4+8.*.COMM.+=8
MOVE 02,.COMM.+=8
FSC 02,3
FADRB 02,.COMM.+5
MOVEM 02,RY#
; 26300 R4=RY
; 25400 C HEIGHT
; 25500 RW=R6
MOVE 02,.COMM.+7
MOVEM 02,RW#
; 25600 C BOTTOM NUM
; 25700 C P5=TOP NUM
; 25800 R6=.COMM.+=8
MOVE 02,.COMM.+=8
MOVEM 02,.COMM.+7
; 25900 RR6=R6
MOVEM 02,RR6#
; 26000 C SIZE
; 26100 C FOR BDR40 -- OR =1
; 26200 M=0
SETZM M#
; 26400 2 .COMM.+=8=0
MT2: SETZM .COMM.+=8
; 26500 C .COMM.+=8=0 FOR BDR FONT??
; 26600 CC IF(R5.NE.99)GO TO 1
; 26700 IF(R5.LT.90)GO TO 3
MOVSI 02,207550
CAMLE 02,.COMM.+6
JRST MT3
; 26800 C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
; 26900 M=-1
SETOM M
; 27000 IF(R5.NE.98)GO TO 4
MOVSI 02,207610
CAME 02,.COMM.+6
JRST MT4
; 27100 C NEXT FOR LINE THROUGH C.
; 27200 RZ=R6
;; MOVE 02,.COMM.+7
;; MOVEM 02,RZ#
; 27300 RY=R4
;; MOVE 02,.COMM.+5
;; MOVEM 02,RY
; 27400 RA=POS
MOVE 02,POSI+=9
MOVEM 02,RA#
; 27500 R6=RX3
MOVE 02,.COMM.+=23
MOVEM 02,.COMM.+7
; 27600 C TO LINE UP WITH R3
; 27700 J10=2
MOVEI 02,2
MOVEM 02,.COMM.+=31
; 27800 C FOR THICK LINE
; 27810 CC R5=9.8+R4
; 28000 R4=R4-3.8
MOVN 02,[3.8]
FADRB 02,.COMM.+5
; 28050 R5=R4+5.6
FADR 02,[5.6]
MOVEM 02,.COMM.+6
; 28100 J7=0
SETZM .COMM.+=28
; 28200 R8=0
SETZM .COMM.+=9
; 28300 CALL ITMSUB
JSA 16,ITMSUB
; 28400 POS=RA
MOVE 02,RA
MOVEM 02,POSI+=9
; 28500 R4=RY
MOVE 02,RY
MOVEM 02,.COMM.+5
; 28600 R6=RZ
MOVE 02,RR6
MOVEM 02,.COMM.+7
; 28700 C GET BACK THE RIGHT PARAMS.
; 28900 4 R5=9999.
MT4: MOVE 02,[9999.0]
MOVEM 02,.COMM.+6
; 29100 C TO CENTER 12S AND 16S
; 29200 3 CALL MAKNUM(R5)
MT3: JSA 16,MAKNUM
JUMP .COMM.+6
; 29300 IF(M)RETURN
SKIPGE M
JRA 16,(16)
; 29400 C STICK AROUND FOR BOTTOM NUM
; 29500 M=-1
SETOM M
; 29700 R6=RR6
MOVE 02,RR6
MOVEM 02,.COMM.+7
; 29600 R4=RY-4.*RR6
FSC 02,2
FSBR 02,RY
MOVNM 02,.COMM.+5
; 29800 R5=RW
MOVE 02,RW#
MOVEM 02,.COMM.+6
; 29900 C GET BOTTOM NUM
; 30000 J3=JZ
MOVE 02,JZ
MOVEM 02,.COMM.+=24
; 30100 R8=0
SETZM .COMM.+=9
; 30200 GO TO 2
JRST MT2 ;30300 END
MAKNUM: 0 ; SUBROUTINE MAKNUM(RNUM)
;100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
;200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
;300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
;400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
;500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
;600 DATA RS/10.0/,RBX/1.0/
MOVE 11,@(16) ;GET RNUM (KEEP 11 CLEAN IN OTHER ROUTINES)
MOVE 02,.COMM.+=9 ; RB8=R8
MOVEM 02,RB8#
MOVE 02,.COMM.+=24 ; J3X=J3
MOVEM 02,J3X# ; P7=0=BDR40; =1=BDI40; =2=PRIM.
JSA 16,NOZERO ; CALL NOZERO(R6)
JUMP .COMM.+7
MOVE 02,.COMM.+7 ; R5=R6
MOVEM 02,.COMM.+6 ; UPPER CASE - BDR40
MOVSI 02,206620 ; R6=48000000.0+(R7+50.)*10000.
FADR 02,.COMM.+=8
FMPR 02,[10000.0]
FADR 02,[48000000.0]
MOVEM 02,.COMM.+7
MOVE 02,[99999999.0] ; R7=99999999.0
MOVEM 02,.COMM.+=8
; 32500 C BLANKS
; 32700 IF(RNUM.NE.9999.)GO TO 2
CAME 11,[9999.0]
JRST MN2
; 32800 C NEXT FOR 'C'OMMON TIME
; 32900 RNUM=12.
MOVSI 11,204600
; 33000 C MAKES A 'C'
; 33100 R4=R4-2.2
MOVN 02,[2.2]
FADRM 02,.COMM.+5
; 33200 C .2 FOR BAD POS. OF LETTERS
; 33300 GO TO 4
JRST MN4
; 33500 2 ONE=0
MN2: SETZM ONE#
KIFIX 11,11 ; 33600 RNUM=IFIX(RNUM)
;; JSA 16,IFIX
;; JUMP 11
;; MOVEM 11
;; JSA 16,FLOAT
;; JUMP 11
;;; MOVE 11,0
FLTR 11,11 ;TLC 11,232000
;; FADR 11,11
; 33700 C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
; 33800 IF(RNUM.EQ.1.)ONE=3.
CAME 11,[1.0]
JRST .+3
MOVSI 02,202600
MOVEM 02,ONE
; 33900 IF(RNUM.GT.9.)GO TO 3
CAMLE 11,[9.0]
JRST MN3
; 34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
; 34100 4 R6=R6+RNUM*100.+47.
;;MN4: MOVSI 02,206570
MN4: MOVSI 03,207620
FMPR 03,11
FADR 3,[47.0]
FADRM 3,.COMM.+7
; 34200 C PUTS BLANK ON END (.47)
; 34300 GO TO 1
JRST MN1
; 34500 3 RJY=10.
MN3: MOVSI 3,204500 ; 3 NOW HAS RJY
;; MOVEM 02,RJY#
CAML 11,[100.0] ; 34600 IF(RNUM.GE.100.)RJY=100.
MOVSI 3,207620
;; MOVEM 03,RJY#
; 34700 B=IFIX(RNUM/RJY)
MOVE 02,11
;; FDVR 02,RJY
FDVR 2,3
KIFIX 2,2 ;JSA 16,IFIX
; JUMP 2
;; MOVEM B
;; JSA 16,FLOAT
;; JUMP B#
FLTR 2,2 ;TLC 0,232000
;; FADR 0,0
MOVEM 2,B
; 34800 C=AMOD(RNUM,RJY)
JSA 16,AMOD
JUMP 11
JUMP 3
MOVEM C#
; 34900 IF(RNUM.LT.100)GO TO 7
CAMGE 11,[100.0]
JRST MN7
; 35000 D=IFIX(C/10.)
MOVE 02,C
FDVR 02,[10.0]
KIFIX 2,2 ;JSA 16,IFIX
;; JUMP 2
;; MOVEM D
;; JSA 16,FLOAT
;; JUMP D
FLTR 2,2 ;TLC 0,232000
; FADR 0,0
MOVEM 2,D#
; 35100 C=AMOD(C,10.)
JSA 16,AMOD
JUMP C
JUMP [10.0]
MOVEM C
; 35200 IF(C.EQ.1.)ONE=ONE+3.
CAME [1.0]
JRST .+3
MOVSI 02,202600
FADRM 02,ONE
; 35300 R7=C*1000000.+999999.0
FMPR 0,[1000000.0]
FADR 0,[999999.0]
MOVEM 0,.COMM.+=8
; 35400 C=D
MOVE 02,D
MOVEM 02,C
; 35500 7 R6=R6+B*100.+C
;;MN7: MOVE 02,.COMM.+7
;; FADR 02,C
MN7: MOVSI 03,207620
FMPR 03,B#
FADR 3,C
FADRM 3,.COMM.+7
; 35600 IF(B.EQ.1.)ONE=ONE+3.
MOVSI 02,201400
CAME 02,B
JRST .+3
MOVSI 3,202600
FADRM 3,ONE
; 35700 IF(C.EQ.1.)ONE=ONE+3.
CAME 02,C
JRST .+3
MOVSI 02,202600
FADRM 02,ONE
; 35800 B=R5
MOVE 02,.COMM.+6
MOVEM 02,B
; 35900 IF(RNUM.GE.100.)B=B*2
CAMGE 11,[100.0]
JRST .+3
MOVSI 02,202400
FMPRB 02,B
; 36000 J3=J3-RS*RSTJ2*B
FMPR 02,[10.0]
FMPR 02,STF+=8
KIFIX 2,2 ;JSA 16,IFIX
; JUMP 2
SUB 2,.COMM.+=24
MOVNM 2,.COMM.+=24
; 36100 C FOR 2 DIGIT NUMBER
; 36600 C ADJUSTS FOR 11, ETC.
; 36900 1 J3=J3+ONE*R5*RSTJ2
MN1: MOVE 02,.COMM.+6
FMPR 02,ONE
FMPR 02,STF+=8
KIFIX 2,2 ;JSA 16,IFIX
; JUMP 2
ADDM 2,.COMM.+=24
; 37000 C CENTERS THE NUMBER '1'
MOVEM 11,RNUM# ;37100 CALL ALPHA
JSA 16,ALPHA
; 37200 J3=J3X
MOVE 02,J3X#
MOVEM 02,.COMM.+=24
; 37300 IF(RB8.EQ.0)RETURN
SKIPN RB8
JRA 16,1(16)
; 37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
FLTR 3,.COMM.+=24 ;MOVE 3,.COMM.+=24 37500 R3=J3-R5
; TLC 3,232000
; FADR 3,3
FSBR 3,.COMM.+6
MOVEM 3,.COMM.+4
SKIPE .COMM.+=31 ;37600 IF(J10.EQ.0)J10=1
JRST .+3
MOVEI 02,1
MOVEM 02,.COMM.+=31 ;USE J10 FOR EVEN THICKER BOX AND CIRC.
; 37800 IF(RNUM.GT.9)R3=R3+R5*RBX
MOVE 11,RNUM ;GET BACK RNUM (11 WIPED OUT WHEN PLOTTING)
CAMG 11,[9.0]
JRST .+4
MOVSI 02,201400
FMPR 02,.COMM.+6
FADRM 02,.COMM.+4
; 37900 C TO SET CENTER IF(RB8.EQ.2)GO TO 5
MOVSI 02,202400
CAMN 02,RB8
JRST MN5
MOVE 02,[0.05] ;38100 R4=R4+R5+.1+.05/R5
FDVR 02,.COMM.+6
FADR 2,[0.1]
FADR 02,.COMM.+6
FADRM 02,.COMM.+5
; 38200 C END OF ABOVE IS FOR SMALL CIRCLES.
MOVSI 02,203440 ;38300 B=4.5
;; MOVEM 02,B
; 38400 IF(RNUM.GE.100.)B=5.5
CAML 11,[100.0]
;; CAMLE 02,11
;; JRST .+3
MOVSI 02,203540
;; MOVEM 02,B
; 38500 R5=R5*B
;; MOVE 02,B
FMPRM 02,.COMM.+6
; 38600 JA=12
MOVEI 02,14
MOVEM 02,.COMM.+1
; 38700 J6=0
SETZM .COMM.+=27
; 38800 J7=0
SETZM .COMM.+=28
; 38900 J8=J10
MOVE 02,.COMM.+=31
MOVEM 02,.COMM.+=29 ;39000 CALL CENTX
JSA 16,CENTX
JSA 16,SLUR ;39100 CALL SLUR
JRA 16,1(16) ;39200 RETURN
; 39400 5 JA=4
MN5: MOVEI 02,4
MOVEM 02,.COMM.+1
; 39500 B=6
MOVSI 02,203600
;; MOVEM 02,B
; 39600 R9=0
SETZM .COMM.+=10
; 39700 IF(RNUM.LT.100.)GO TO 8
CAMGE 11,[100.0]
JRST MN8
; 39800 B=9.
MOVSI 02,204440
;; MOVEM 02,B
; 39900 R9=R5*6.
MOVSI 1,203600
FMPR 1,.COMM.+6
MOVEM 1,.COMM.+=10
; 40000 C MAKES RECTANGLE IF ā100
; 40100 8 R4=R4+R5*.7+.1
MN8: MOVE 03,[0.7]
FMPR 03,.COMM.+6
FADR 3,[0.1]
FADRM 3,.COMM.+5
; 40200 R8=R5*B
;; MOVE 02,.COMM.+6
;; FMPR 02,B
FMPR 2,.COMM.+6
MOVEM 02,.COMM.+=9
; 40300 J5=50
MOVEI 02,62
MOVEM 02,.COMM.+=26
; 40400 CALL ITMSUB
JSA 16,ITMSUB
; 40500 C RETURNS ORIG. HORIZ. POS.
JRA 16,1(16) ;40600 END
END